Análisis de los datos electorales

Paquetes necesarios

Code
rm(list = ls())
library(tidyverse)
library(glue)
library(forcats)
library(lubridate)
library(waffle)
library(ggpol)
library(ggforce)
library(sf) # para importar archivos shapefiles
library(broom) # Para transformar los archivos shapefiles 
library(gridExtra)
library(grid)
library(gganimate)

Datos empleados

  • election_data: archivo con las elecciones al congreso
  • cod_mun: archivo con los códigos y nombres de cada municipio
  • abbrev: siglas de cada partido
  • surveys: encuestas electorales desde 1982.
  • escannos_provincia_anno: número de escaños por provincia y año
  • shapefile_provincias: mapa de cada provincia

Depuración de datos

Datos únicamente del período de tiempo que incluye las elecciones desde 2008 hasta las últimas elecciones de 2019.

Solo nos interesarán los siguientes partidos:

-   PARTIDO SOCIALISTA OBRERO ESPAÑOL
-   PARTIDO POPULAR
-   CIUDADANOS
-   PARTIDO NACIONALISTA VASCO
-   BLOQUE NACIONALISTA GALLEGO
-   UNIDAS PODEMOS - IU
-   ESQUERRA REPUBLICANA DE CATALUNYA
-   EH - BILDU 
-   VOX

Convertir a tidy data

Code
eleccion_tidy <- 
  election_data |> 
  pivot_longer(cols = c(16:471), 
               names_to = "partido", 
               values_to = "votos", 
               values_drop_na = TRUE)
Code
tabla <- eleccion_tidy |> 
  distinct(anno, mes, tipo_eleccion, vuelta, codigo_distrito_electoral)

tabla
# A tibble: 6 × 5
   anno mes   tipo_eleccion vuelta codigo_distrito_electoral
  <dbl> <chr> <chr>          <dbl>                     <dbl>
1  2008 03    02                 1                         0
2  2011 11    02                 1                         0
3  2015 12    02                 1                         0
4  2016 06    02                 1                         0
5  2019 04    02                 1                         0
6  2019 11    02                 1                         0

Datos de 6 elecciones nacionales: 2008,2011,2015,2016,2019 (abril) y 2019 (noviembre).

Depuración nombres de partidos

Creación de una función para depurar los nombres de los partidos y reagrupar los demás partidos en la categoría “Otros”.

Code
nombres_partidos <- c("PARTIDO SOCIALISTA OBRERO ESPAÑOL","PARTIDO POPULAR", "CIUDADANOS", "PARTIDO NACIONALISTA VASCO", "BLOQUE NACIONALISTA GALLEGO", "UNIDAS PODEMOS - IU", "ESQUERRA REPUBLICANA DE CATALUNYA",  "EH - BILDU", "VOX")

cambia_nombres <- function(partido, nombres) {
  partido_min <- str_to_lower(partido)
  nombres_min <- str_to_lower(nombres)
  
  if (str_detect(partido_min, "\\bsortu\\b|\\beusko alkartasuna\\b|\\baralar\\b|\\balternatiba\\b|\\beuskal herria bildu\\b")) { 
    #Añado el nombre completo de EH - Bildu y cambio a str_detect porque antes no captaba todo lo que debía (ej 2008, Victoria-Gasteiz EZKER BATUA-BERDEAK-ALTERNATIVA)
    return("EH - BILDU")
  }
  
   if (str_detect(partido_min, "\\bunidas podemos\\b|\\bunidos podemos\\b|\\bpodemos\\b|\\biu\\b|\\bpodem\\b|\\bezker batua\\b")) {
    return("UNIDAS PODEMOS - IU")
  }
  
  if (str_detect(partido_min,"\\bpartido nacionalista vasco\\b")) {
    return("PARTIDO NACIONALISTA VASCO")
  }
  
  if (str_detect(partido_min,"\\bpsoe\\b|\\bpartido socialista obrero español\\b\\bpartido socialista de euskadi\\b|\\bpartit dels socialistes de catalunya\\b|\\bpartido dos socialistas de galicia\\b")) {
    return("PARTIDO SOCIALISTA OBRERO ESPAÑOL")
  }
  
    if (str_detect(partido_min,"\\bpp\\b|\\bpartido popular\\b")) {
    return("PARTIDO POPULAR")
    }
  
  if (str_detect(partido_min,"\\bbloque nacionalista galego\\b")) {
    return("BLOQUE NACIONALISTA GALLEGO")  
  }
  
  if (str_detect(partido_min,"\\bpartido de la ciudadanía\\b|\\bpartido de la ciudadania\\b")) {
    return("CIUDADANOS")  
  }
  
  if (str_detect(partido_min,"\\besquerra republicana de catalunya\\b")) { #Nótese que quedan aún partidos tipo coalición (considero que deberían incluirse)
    return("ESQUERRA REPUBLICANA DE CATALUNYA")  
  }
  
  if (any(partido_min == nombres_min)) {
    return(partido)  
  }
  
  return("OTRO")
}

#Aplicar función al dataframe
eleccion_tidy_filt <- 
  eleccion_tidy |> 
  rowwise() |> 
  mutate(partido_n = cambia_nombres(partido, nombres_partidos))

#Reagrupar partido "otro"
eleccion_resumen <- 
  eleccion_tidy_filt |>
  group_by(partido_n,anno,mes,codigo_ccaa,codigo_provincia,codigo_municipio) |> 
  mutate(votos_totales_partido = sum(votos)) |> 
  ungroup() # Ver anotaciones del cambio

Encuestas

Debes descartar las encuestas que:

-   se refieran a elecciones anteriores a 2008
-   sean a pie de urna
-   tamaño muestral desconocido o inferior a 500.
-   tenga 1 día o menos de trabajo de campo.
Code
surveys_tidy <- 
  surveys |> 
  pivot_longer(cols = c(11:59), 
               names_to = "partidos", 
               values_to = "intencion_voto", 
               values_drop_na = TRUE) |>
  drop_na(size) |>  
  filter(size >=500 & exit_poll == FALSE) |>   #tamaño muestral y a pie de urna
  filter(date_elec >= "2008-01-01") |>  #elecciones desde 2008
  mutate(duracion_t_campo = field_date_to - field_date_from) |> 
  filter(duracion_t_campo > 1) |> #descartar enucentas con 1 días o menos de trabajo de campo
  select(-exit_poll) |>  #quitar var. a pie de urna porque no es informativa (sólo quedan las que no lo)
  mutate(siglas = case_when(
            partidos == "PSOE" ~ "PSOE",
            partidos == "PP" ~ "PP",
            partidos == "CC" ~ "C's",
            partidos == "BNG" ~ "BNG",
            partidos == "ERC" ~ "ERC",
            partidos == "IU" ~ "PODEMOS-IU",
            partidos == "UP" ~ "PODEMOS-IU",
            partidos == "PODEMOS" ~ "PODEMOS-IU",
            partidos == "EH-BILDU" ~ "EH-BILDU",
            partidos == "EAJ-PNV" ~ "PNV",
            partidos == "VOX" ~ "VOX",
            TRUE ~ "OTRO" ))

Creación de tabla maestra

Tabla maestra que contiene nombres de municipios, sus códigos y las siglas de cada partido.

Code
# Tabla maestra que contiene nombres de municipios, sus códigos y las siglas de cada partido (para facilitar la visualización)

abbrev_modif <- abbrev|> 
  rowwise() |> 
  mutate(partidos = cambia_nombres(denominacion, nombres_partidos)) |> 
  select(-denominacion) |> 
  distinct(partidos, .keep_all = TRUE) |> 
  mutate(siglas = case_when(
    partidos == "PARTIDO NACIONALISTA VASCO"  ~ "PNV",
    partidos == "PARTIDO SOCIALISTA OBRERO ESPAÑOL"  ~ "PSOE",
    partidos == "UNIDAS PODEMOS - IU" ~ "PODEMOS-IU",
    partidos == "EH - BILDU" ~ "EH-BILDU",
    partidos == "OTRO"  ~ "OTRO",
    TRUE ~ siglas))

tabla_maestra <-
  eleccion_resumen |> 
  unite(col = "cod_poblacion", codigo_ccaa, codigo_provincia, codigo_municipio, sep = "-", remove = FALSE) |> 
  left_join(cod_mun, by =  c("cod_poblacion" = "cod_mun")) |> 
  select(-c(tipo_eleccion,vuelta)) |> 
  left_join(abbrev_modif, by = c("partido_n" = "partidos"))

Resultados generales de las elecciones

Code
# Preparamos los resultados de las elecciones, vemos qué porcentaje de votos ha ido a cada partido

datos_generales_elecciones <- 
  tabla_maestra |>
  group_by(anno,mes) |> 
  distinct(anno, mes, cod_poblacion, codigo_ccaa, codigo_provincia, codigo_municipio, codigo_distrito_electoral, censo, votos_blancos, votos_nulos, votos_candidaturas) |> 
  mutate(censo = sum(censo),
         votos_blancos = sum(votos_blancos),
         votos_nulos = sum(votos_nulos),
         votos_candidaturas = sum(votos_candidaturas),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup() |> 
  distinct(eleccion, censo, votos_blancos, votos_nulos, votos_candidaturas) 

datos_partido <-
  tabla_maestra |> 
  group_by(anno, mes, siglas) |> 
  mutate(votos_partido = sum(votos),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup() |> 
  distinct(eleccion, siglas, votos_partido) |> 
  left_join(datos_generales_elecciones, by = c("eleccion" = "eleccion")) |> 
  mutate(votos_porc_votantes_cand = round(votos_partido / votos_candidaturas, 2), # Porcentaje sobre la gente que voto candidaturas
         votos_porc_censo = round(votos_partido / censo, 2)) # Porcentaje sobre la gente censada,

datos_partido <-
  datos_partido |> 
  mutate(siglas = factor(siglas, levels = c("PP","PSOE","PNV","OTRO","ERC","BNG","PODEMOS-IU","C's","EH-BILDU","VOX"), 
                         ordered = TRUE)) 

#Colores de partidos
colores_partidos <- c("OTRO" = "grey45", "PP" = "#17589d", "PNV" = "#308444", 
                      "PODEMOS-IU" = "#6b1f5f", "VOX" = "#5ac035", 
                      "PSOE" = "#c20e1a", "ERC" = "#fcc34e", "BNG" = "#76b3dd",
                      "C's" = "#fb5000", "EH-BILDU"= "#1af7db")

#Resultados generales
grafico_resultados_elecciones <- 
  ggplot(datos_partido, aes(x = eleccion, y = votos_porc_votantes_cand, fill = siglas)) +
  geom_col(position = "fill") +
    geom_text(
    aes(
      label = ifelse(votos_porc_votantes_cand > 0.08, scales::percent(votos_porc_votantes_cand, accuracy = 1), ""),
      y = votos_porc_votantes_cand / 2
    ),
    position = position_fill(vjust = 0.5),
    size = 3,
    color = "white"
  ) +
  scale_fill_manual(values = colores_partidos) +
  labs(
    title = "Resultados generales",
    x = "Elecciones",
    y = "Porcentaje de votos",
    fill = "Partido"
  ) +
  theme_minimal() +
    theme( plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)))

grafico_resultados_elecciones
Code
provincias_sf <- st_as_sf(shapefile_provincias)

mas_votado_prov <-
  tabla_maestra |> 
  group_by(anno, mes, codigo_provincia, siglas) |> 
  mutate(votos_partido = sum(votos),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup()

#Mapa 2015
mas_votado_prov_15 <- mas_votado_prov |> 
  filter(eleccion == "2015") |> 
  distinct(eleccion, codigo_provincia, siglas, votos_partido) |> 
  group_by(eleccion, codigo_provincia) |> 
  mutate(votos_totales = sum(votos_partido)) |> 
  slice_max(votos_partido) |> 
  mutate(porc = votos_partido / votos_totales)

mas_votado_prov_15 <-
  mas_votado_prov_15 |> 
  mutate(siglas = factor(siglas, levels = c("PP","PSOE","PNV","OTRO","ERC","BNG","PODEMOS-IU","C's","EH-BILDU","VOX"), 
                         ordered = TRUE))

provincias_sf_15 <- 
  provincias_sf %>%
  left_join(mas_votado_prov_15, by = c("Codigo" = "codigo_provincia"))

grafico_pais_15 <-
  ggplot(data = provincias_sf_15) +
  geom_sf(aes(fill = siglas, alpha = porc), color = "black") +
  scale_fill_manual(values = colores_partidos) + 
  theme_minimal() +
  labs(title = "2015",
       fill = "") +
  guides(alpha = "none") +
  theme(
    legend.position = "bottom",
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)))

#Mapa 2008
mas_votado_prov_08 <- mas_votado_prov |> 
  filter(eleccion == "2008") |> 
  distinct(eleccion, codigo_provincia, siglas, votos_partido) |> 
  group_by(eleccion, codigo_provincia) |> 
  mutate(votos_totales = sum(votos_partido)) |> 
  slice_max(votos_partido) |> 
  mutate(porc = votos_partido / votos_totales)

mas_votado_prov_08 <-
  mas_votado_prov_08 |> 
  mutate(siglas = factor(siglas, levels = c("PP","PSOE","PNV","OTRO","ERC","BNG","PODEMOS-IU","C's","EH-BILDU","VOX"), 
                         ordered = TRUE))

provincias_sf_08 <- 
  provincias_sf %>%
  left_join(mas_votado_prov_08, by = c("Codigo" = "codigo_provincia"))

grafico_pais_08 <-
  ggplot(data = provincias_sf_08) +
  geom_sf(aes(fill = siglas, alpha = porc), color = "black") +
  scale_fill_manual(values = colores_partidos) +  
  theme_minimal() +
  labs(title = "2008",
       fill = "") +
  guides(alpha = "none") +
  theme(
    legend.position = "bottom",
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)))

#Mapa 2019(nov)
mas_votado_prov_19 <- mas_votado_prov |> 
  filter(eleccion == "2019 (noviembre)") |> 
  distinct(eleccion, codigo_provincia, siglas, votos_partido) |> 
  group_by(eleccion, codigo_provincia) |> 
  mutate(votos_totales = sum(votos_partido)) |> 
  slice_max(votos_partido) |> 
  mutate(porc = votos_partido / votos_totales)

mas_votado_prov_19 <-
  mas_votado_prov_19 |> 
  mutate(siglas = factor(siglas, levels = c("PP","PSOE","PNV","OTRO","ERC","BNG","PODEMOS-IU","C's","EH-BILDU","VOX"), 
                         ordered = TRUE))

provincias_sf_19 <- 
  provincias_sf %>%
  left_join(mas_votado_prov_19, by = c("Codigo" = "codigo_provincia"))

grafico_pais_19 <-
  ggplot(data = provincias_sf_19) +
  geom_sf(aes(fill = siglas, alpha = porc), color = "black") +
  scale_fill_manual(values = colores_partidos) + 
  theme_minimal() +
  labs(title = "Noviembre 2019",
       fill = "") +
  guides(alpha = "none") +
  theme(
    legend.position = "bottom",
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)))

grid.arrange(grafico_pais_08, grafico_pais_15 , grafico_pais_19, ncol = 3, nrow = 1)

Votos a candidatura en los municipios grandes**

  • Se filtran los datos según el censo de los municipios

  • Se escogen los partidos más votados por municipio en cada elección

  • Se contabiliza en cuántos municipios gana cada partido

Code
# DATOS PREGUNTA 1
datos_p1 <- 
  tabla_maestra |> #Una fila por municipio
  filter(censo > 100000) |> #Condición del censo
  slice_max(votos_totales_partido, by = c(anno, mes, cod_poblacion)) |> #Partido más votado por elección
  distinct(anno, mes, municipio, cod_poblacion, siglas) |>  #Quito filas repetidas (partidos resultantes de la agrupación)
  group_by(anno, mes) |> 
  count(siglas) |> #Por elección cuento nº de veces qeu aparece el partido como más votado (=nº de municipios donde ganó) 
  ungroup() |> 
  mutate(
    siglas = factor(siglas, levels = unique(siglas)), # Aseguramos el orden
    eleccion = case_when(
      anno == 2008 ~ "2008",
      anno == 2011 ~ "2011",
      anno == 2015 ~ "2015",
      anno == 2016 ~ "2016",
      anno == 2019 & mes == "04" ~ 
      "2019 (abril)",
      anno == 2019 & mes == "11" ~ 
        "2019 (noviembre)"
    )
  )

plot_p1 <- ggplot(datos_p1, aes(fill = siglas, values = n)) +
  geom_waffle(n_rows = 10) +
  facet_grid(~eleccion) +
  scale_fill_manual(values = colores_partidos) +
  labs(title = "Partidos ganadores en municipios con >100.000 habitantes",
         fill = "Partido") +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    axis.text = element_blank(),
    strip.text = element_text(face = "bold",
                              size =9),
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)),
    panel.grid = element_blank())
Code
plot_p1 

¿Qué partido fue el segundo cuando el primero fue el PSOE? ¿Y cuando el primero fue el PP?

En la mayoría de municipios grandes gana el PP o el PSOE, ¿son siemore los partidos más populares?

Code
# DATOS PREGUNTA 2

datos_p2_previo <-
  tabla_maestra |>
  filter(censo > 100000) |> 
  slice_max(votos_totales_partido, by = c(anno, mes, cod_poblacion)) |> 
  distinct(anno, mes, municipio, cod_poblacion, siglas)

# Apartado a: El PSOE es el primer partido

datos_p2_psoe_prim <-
  datos_p2_previo |> 
  filter(siglas == "PSOE")

datos_p2_a <- 
  tabla_maestra |> 
  filter(censo > 100000) |> 
  distinct(anno, mes, municipio, cod_poblacion, siglas, votos_totales_partido) |>
  group_by(anno, mes, cod_poblacion) |> 
  slice_max(votos_totales_partido, n = 2) |> 
  mutate(rank_grupo = rank(-votos_totales_partido)) |> 
  filter(rank_grupo == 2) |> 
  inner_join(datos_p2_psoe_prim, by = c("cod_poblacion", "anno", "mes"), suffix = c("_seg", "_prim")) |> 
  group_by(anno, mes) |> 
  count(siglas_seg) |>
  ungroup() |> 
  mutate(
    siglas = factor(siglas_seg, levels = unique(siglas_seg)), 
    eleccion = case_when(
      anno == 2008 ~ "2008",
      anno == 2011 ~ "2011",
      anno == 2015 ~ "2015",
      anno == 2016 ~ "2016",
      anno == 2019 & mes == "04" ~ 
      "2019 (abril)",
      anno == 2019 & mes == "11" ~ 
        "2019 (noviembre)"
    )
  )

# Gráfico para ver qué partidos son los segundos más votados cuando el PSOE es el primero
plot_p2_a <- datos_p2_a |> 
  mutate(eleccion = fct_reorder(eleccion, desc(eleccion))) |> 
  group_by(eleccion) |> 
  mutate(perc = scales::percent(n / sum(n), accuracy = .1, trim = FALSE)) |> 
  ungroup() |> 
  ggplot(aes(x = eleccion, y = n,fill = siglas_seg))  +
  geom_col(position = "fill") + 
  scale_fill_manual(values = colores_partidos) + 
  labs(title = "Segundo partido más votado tras el PSOE",
       subtitles = "En municipios con >100.000 habitantes",
         fill = "Partido",
       x = "Elecciones",
       y= "") +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    strip.text = element_text(face = "bold",
                              size =9),
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)),
    panel.grid = element_blank()) +
  coord_flip() +
  geom_text(aes(label = perc, y = n / 2),
    position = position_fill(vjust = 0.5),
    size = 3, color = "white")

datos_p2_pp_prim <-
  datos_p2_previo |> 
  filter(siglas == "PP")

datos_p2_b <- 
  tabla_maestra |> 
  filter(censo > 100000) |> 
  distinct(anno, mes, municipio, cod_poblacion, siglas, votos_totales_partido) |>
  group_by(anno, mes, cod_poblacion) |> 
  slice_max(votos_totales_partido, n = 2) |> 
  mutate(rank_grupo = rank(-votos_totales_partido)) |> 
  filter(rank_grupo == 2) |> 
  inner_join(datos_p2_pp_prim, by = c("cod_poblacion", "anno", "mes"), suffix = c("_seg", "_prim")) |> 
  group_by(anno, mes) |> 
  count(siglas_seg) |>
  ungroup() |> 
  mutate(
    siglas = factor(siglas_seg, levels = unique(siglas_seg)), 
    eleccion = case_when(
      anno == 2008 ~ "2008",
      anno == 2011 ~ "2011",
      anno == 2015 ~ "2015",
      anno == 2016 ~ "2016",
      anno == 2019 & mes == "04" ~ 
      "2019 (abril)",
      anno == 2019 & mes == "11" ~ 
        "2019 (noviembre)"
    )
  )

# Gráfico para ver qué partidos son los segundos más votados cuando el PP es el primero
plot_p2_b <- datos_p2_b |> 
  mutate(eleccion = fct_reorder(eleccion, desc(eleccion))) |> 
  group_by(eleccion) |> 
  mutate(perc = scales::percent(n / sum(n), accuracy = .1, trim = FALSE)) |> 
  ungroup() |> 
  ggplot(aes(x = eleccion, y = n,fill = siglas_seg))  +
  geom_col(position = "fill") + 
  scale_fill_manual(values = colores_partidos) + 
  labs(title = "Segundo partido más votado tras el PP",
       subtitles = "En municipios con >100.000 habitantes",
         fill = "Partido",
       x = "Elecciones",
       y= "") +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    strip.text = element_text(face = "bold",
                              size =9),
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)),
    panel.grid = element_blank()) +
  coord_flip() +
  geom_text(aes(label = perc, y = n / 2),
    position = position_fill(vjust = 0.5),
    size = 3, color = "white")
Code
grid.arrange(plot_p2_a, plot_p2_b, ncol = 2)

Parte 3

Code
tabla_pg4 <- 
  tabla_maestra |>
  # Votos totales por población
  group_by(anno, mes, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion) |>
  summarise(votos_totales = sum(votos)) |>
  distinct(anno, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion, votos_totales)

tabla_pg4_censo <-
  tabla_maestra |> 
  distinct(anno, mes, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion, censo)

tabla_pg4_censoxvotos <-
  left_join(x = tabla_pg4_censo, 
            y = tabla_pg4, 
            by = c("anno" = "anno", 
                   "mes" = "mes",
                   "codigo_ccaa" = "codigo_ccaa",
                   "codigo_provincia" = "codigo_provincia",
                   "codigo_municipio" = "codigo_municipio",
                   "cod_poblacion" = "cod_poblacion")) |> 
  group_by(anno, mes, codigo_ccaa) |> 
  summarise(censo_tot = sum(censo), votos_tot = sum(votos_totales)) |> 
  mutate(
    porc = votos_tot / censo_tot,
    comunidad_autonoma = case_when(
      codigo_ccaa == "01" ~ "Andalucía",
      codigo_ccaa == "02" ~ "Aragon",
      codigo_ccaa == "03" ~ "Asturias",
      codigo_ccaa == "04" ~ "Baleares",
      codigo_ccaa == "05" ~ "Canarias",
      codigo_ccaa == "06" ~ "Cantabria",
      codigo_ccaa == "07" ~ "Castilla y Leon",
      codigo_ccaa == "08" ~ "Castilla La Mancha",
      codigo_ccaa == "09" ~ "Cataluña",
      codigo_ccaa == "10" ~ "Comunidad Valenciana",
      codigo_ccaa == "11" ~ "Extremadura",
      codigo_ccaa == "12" ~ "Galicia",
      codigo_ccaa == "13" ~ "Comunidad de Madrid",
      codigo_ccaa == "14" ~ "Murcia",
      codigo_ccaa == "15" ~ "Navarra",
      codigo_ccaa == "16" ~ "País Vasco",
      codigo_ccaa == "17" ~ "La Rioja",
      codigo_ccaa == "18" ~ "Ceuta",
      TRUE ~ "Melilla"
    )
  )

# Graficar los datos
ggplot(tabla_pg4_censoxvotos) +
  geom_line(aes(x = anno, y = porc, color = comunidad_autonoma), size = 0.7, alpha = 0.8) +
  scale_x_continuous(
    breaks = seq(2007, 2020, by = 1), 
    labels = seq(2007, 2020, by = 1)
  ) +
  scale_color_viridis_d() + 
  labs(
    title = "Relación entre Votos Totales y Censo Total por Comunidad Autónoma",
    x = "Año",
    y = "Porcentaje de Votos sobre Censo",
    color = "Comunidad Autónoma"
  ) +
  theme_minimal() +
  theme(
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9)
  )
Code
#Se observa como el porcentaje de votos respecto al censo fue disminuyendo alrededor del 2015 para la mayoría de comunidades, seguido de una recuperacíon en los años posteriores (hacia 2017-2018).

#Las comunidades tienen diferentes niveles de participación. Algunas mantienen un porcentaje más alto (cerca del 80%), mientras que otras caen a valores significativamente más bajos (alrededor del 50% en algunos años).

Parte 3: Evolución del Porcentaje de Voto en Relación al Censo por Comunidad Autónoma

Code
# Crear tabla con votos totales por población
tabla_pg4 <- 
  tabla_maestra |>
  group_by(anno, mes, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion) |>
  summarise(votos_totales = sum(votos)) |>
  distinct(anno, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion, votos_totales)

# Crear tabla con el censo
tabla_pg4_censo <- 
  tabla_maestra |> 
  distinct(anno, mes, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion, censo)

# Unir las dos tablas y calcular porcentaje de votos sobre censo
tabla_pg4_censoxvotos <- 
  left_join(x = tabla_pg4_censo, 
            y = tabla_pg4, 
            by = c("anno" = "anno", 
                   "mes" = "mes",
                   "codigo_ccaa" = "codigo_ccaa",
                   "codigo_provincia" = "codigo_provincia",
                   "codigo_municipio" = "codigo_municipio",
                   "cod_poblacion" = "cod_poblacion")) |> 
  group_by(anno, mes, codigo_ccaa) |> 
  summarise(censo_tot = sum(censo), votos_tot = sum(votos_totales)) |> 
  mutate(porc = votos_tot / censo_tot,
         comunidad_autonoma = case_when(
           codigo_ccaa == "01" ~ "Andalucia",
           codigo_ccaa == "02" ~ "Aragon",
           codigo_ccaa == "03" ~ "Asturias",
           codigo_ccaa == "04" ~ "Baleares",
           codigo_ccaa == "05" ~ "Canarias",
           codigo_ccaa == "06" ~ "Cantabria",
           codigo_ccaa == "07" ~ "Cast y Leon",
           codigo_ccaa == "08" ~ "Cast La Mancha",
           codigo_ccaa == "09" ~ "Catalunya",
           codigo_ccaa == "10" ~ "Com Valenciana",
           codigo_ccaa == "11" ~ "Extremadura",
           codigo_ccaa == "12" ~ "Galicia",
           codigo_ccaa == "13" ~ "Com de Madrid",
           codigo_ccaa == "14" ~ "Murcia",
           codigo_ccaa == "15" ~ "Navarra",
           codigo_ccaa == "16" ~ "Pais Vasco",
           codigo_ccaa == "17" ~ "La Rioja",
           codigo_ccaa == "18" ~ "Ceuta",
           TRUE ~ "Melilla"
         ),
      fecha = as.Date(paste(anno, mes, "01", sep = "-"))) |> 
  group_by(codigo_ccaa) |> 
  mutate(mean_porc = mean(porc),
         tipos_ccaa = case_when(
           mean_porc > 0.74 ~ "Porc > 0.73",
           mean_porc > 0.71 ~ "Porc > 0.71 y < 0.73",
           mean_porc > 0.65 ~ "Porc > 0.65 y < 0.71",
           TRUE ~ "Porc <= 0.65"
         ))

# Graficar los datos

grafica_menos65 <- 
  ggplot(tabla_pg4_censoxvotos |>  
           filter(tipos_ccaa == "Porc <= 0.65")) +
  geom_line(aes(x = fecha, y = porc, color = comunidad_autonoma), size = 1, alpha = 0.8) +  
  scale_x_date(
    breaks = as.Date(c("2008-01-01", "2011-01-01", "2015-01-01", "2016-01-01", "2018-01-01", "2019-01-01")),
    labels = c("2008", "2011", "2015", "2016", "2018", "2019")  
  ) +
  scale_y_continuous(
    labels = function(porc) paste0(porc * 100, "%")        
  ) +
  scale_color_viridis_d() +  
  labs(
    color = "Porcentaje de voto",
    subtitle = "Porcentaje <= 0.65"
  ) +  
  theme_minimal() +
  theme(
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    axis.title.y = element_blank(),
    axis.title.x = element_blank(),
    axis.text.x = element_text(angle = 80, size = 7),
    strip.text = element_text(face = "bold", size = 4.5),
    plot.title = element_text(face = "bold", hjust = 0.5, margin = margin(b = 10)),
    panel.grid = element_blank()
  )

# Gráfica para el porcentaje entre 0.65 y 0.71
grafica_menos71 <- 
  ggplot(tabla_pg4_censoxvotos |>  
           filter(tipos_ccaa == "Porc > 0.65 y < 0.71")) +
  geom_line(aes(x = fecha, y = porc, color = comunidad_autonoma), size = 1, alpha = 0.8) +  
  scale_x_date(
    breaks = as.Date(c("2008-01-01", "2011-01-01", "2015-01-01", "2016-01-01", "2018-01-01", "2019-01-01")),
    labels = c("2008", "2011", "2015", "2016", "2018", "2019")  
  ) +
  scale_y_continuous(
    labels = function(porc) paste0(porc * 100, "%")        
  ) +
  scale_color_viridis_d() +  
  labs(
    color = "Porcentaje de voto",
    subtitle = "Porcentaje entre 0.65 y 0.71"
  ) +  
  theme_minimal() +
  theme(
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    axis.title.y = element_blank(),
    axis.title.x = element_blank(),
    axis.text.x = element_text(angle = 80, size = 7),
    strip.text = element_text(face = "bold", size = 4.5),
    plot.title = element_text(face = "bold", hjust = 0.5, margin = margin(b = 10)),
    panel.grid = element_blank()
  )

# Gráfica para el porcentaje entre 0.71 y 0.73
grafica_menos73 <- 
  ggplot(tabla_pg4_censoxvotos |>  
           filter(tipos_ccaa == "Porc > 0.71 y < 0.73")) +
  geom_line(aes(x = fecha, y = porc, color = comunidad_autonoma), size = 1, alpha = 0.8) +   
  scale_x_date(
    breaks = as.Date(c("2008-01-01", "2011-01-01", "2015-01-01", "2016-01-01", "2018-01-01", "2019-01-01")),
    labels = c("2008", "2011", "2015", "2016", "2018", "2019")  
  ) +
  scale_y_continuous(
    labels = function(porc) paste0(porc * 100, "%")        
  ) +
  scale_color_viridis_d() +  
  labs(
    color = "Porcentaje de voto",
    subtitle = "Porcentaje entre 0.71 y 0.73"
  ) +  
  theme_minimal() +
  theme(
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    axis.title.y = element_blank(),
    axis.title.x = element_blank(),
    axis.text.x = element_text(angle = 80, size = 7),
    strip.text = element_text(face = "bold", size = 4.5),
    plot.title = element_text(face = "bold", hjust = 0.5, margin = margin(b = 10)),
    panel.grid = element_blank()
  )

# Gráfica para el porcentaje > 0.73
grafica_mas73 <- 
  ggplot(tabla_pg4_censoxvotos |>  
           filter(tipos_ccaa == "Porc > 0.73")) +
  geom_line(aes(x = fecha, y = porc, color = comunidad_autonoma), size = 1, alpha = 0.8) +  
  scale_x_date(
    breaks = as.Date(c("2008-01-01", "2011-01-01", "2015-01-01", "2016-01-01", "2018-01-01", "2019-01-01")),
    labels = c("2008", "2011", "2015", "2016", "2018", "2019")  
  ) +
  scale_y_continuous(
    labels = function(porc) paste0(porc * 100, "%")        
  ) +
  scale_color_viridis_d() +  
  labs(
    color = "Porcentaje de voto",
    subtitle = "Porcentaje > 0.73"
  ) +  
  theme_minimal() +
  theme(
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    axis.title.y = element_blank(),
    axis.title.x = element_blank(),
    axis.text.x = element_text(angle = 80, size = 7),
    strip.text = element_text(face = "bold", size = 4.5),
    plot.title = element_text(face = "bold", hjust = 0.5, margin = margin(b = 10)),
    panel.grid = element_blank()
  )

grid.arrange(grafica_menos65, grafica_menos71, grafica_menos73, grafica_mas73, ncol = 2, nrow = 2, top = "Porcentaje de voto por comunidad")
Code
#Se observan disparidades en la participación electoral por comunidad autónoma, con Ceuta y Melilla (\<60 %) en el nivel más bajo y comunidades como La Rioja y País Vasco (\> 70%) en el más alto.

#Las regiones con menor participación muestran cierta recuperación hacia 2018, mientras que las comunidades con alta participación mantienen estabilidad a lo largo del tiempo.

Parte 3: ¿Es cierto que determinados partidos ganan en las zonas rurales?

Code
tabla_maestra <- tabla_maestra |> 
  mutate(zona = case_when(
    censo < 10000 ~ "rural",  
    TRUE ~ "urbano"
  ))
# Análisis de partidos ganadores en zonas rurales
datos_rurales <- 
  tabla_maestra |>  
  filter(zona == "rural") |>  
  slice_max(votos_totales_partido, by = c(anno, mes, cod_poblacion)) |>  
  distinct(anno, mes, municipio, cod_poblacion, siglas) |>  
  group_by(anno, mes) |>  
  count(siglas) |>  
  ungroup() |>  
  mutate(
    siglas = factor(siglas, levels = unique(siglas)),  
    eleccion = case_when(
      anno == 2008 ~ "2008",
      anno == 2011 ~ "2011",
      anno == 2015 ~ "2015",
      anno == 2016 ~ "2016",
      anno == 2019 & mes == "04" ~ "2019 (abril)",
      anno == 2019 & mes == "11" ~ "2019 (noviembre)"
    )
  )

datos_rurales |> 
  ggplot(aes(x = reorder(siglas, -n), y = n, fill = siglas)) +  
  geom_bar(stat = "identity") +  
  scale_fill_manual(values = c("OTRO" = "grey45", "PP" = "#17589d", "PNV" = "#308444", 
                               "PODEMOS-IU" = "#6b1f5f","VOX" = "#5ac035", 
                               "PSOE" = "#c20e1a", "ERC" = "#fcc34e", "BNG" = "#76b3dd",
                               "C's" = "#fb5000")) +  
  labs(
    title = "Partidos Ganadores en Zonas Rurales",
    x = "Partido",
    y = "Número de Municipios Rurales Ganados",
    fill = "Partido"
  ) +
  theme_minimal() +  
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +  
  theme(legend.position = "none")

Code
## Se observa como el PP es el partido dominante en las zonas rurales
Code
# Crear la tabla con el número de municipios ganados por cada partido
tabla_partidos_rurales <- datos_rurales |> 
  group_by(siglas) |> 
  summarise(municipios_ganados = sum(n)) |> 
  arrange(desc(municipios_ganados)) |> 
  mutate(mensaje = glue("{siglas} ganó en {municipios_ganados} municipios rurales"))
tabla_partidos_rurales
# A tibble: 10 × 3
   siglas     municipios_ganados mensaje                                  
   <fct>                   <int> <glue>                                   
 1 PP                      24019 PP ganó en 24019 municipios rurales      
 2 PSOE                    13129 PSOE ganó en 13129 municipios rurales    
 3 OTRO                     5124 OTRO ganó en 5124 municipios rurales     
 4 ERC                      1091 ERC ganó en 1091 municipios rurales      
 5 PNV                       717 PNV ganó en 717 municipios rurales       
 6 PODEMOS-IU                682 PODEMOS-IU ganó en 682 municipios rurales
 7 EH-BILDU                  464 EH-BILDU ganó en 464 municipios rurales  
 8 VOX                       345 VOX ganó en 345 municipios rurales       
 9 C's                       158 C's ganó en 158 municipios rurales       
10 BNG                         6 BNG ganó en 6 municipios rurales         
Code
# Partidos ganadores en zonas rurales por año
datos_rurales |> 
  ggplot(aes(x = reorder(siglas, -n), y = n, fill = siglas)) +  
  geom_bar(stat = "identity") +  
  scale_fill_manual(values = c("OTRO" = "grey45", "PP" = "#17589d", "PNV" = "#308444", 
                               "PODEMOS-IU" = "#6b1f5f", "VOX" = "#5ac035", 
                               "PSOE" = "#c20e1a", "ERC" = "#fcc34e", "BNG" = "#76b3dd",
                               "C's" = "#fb5000")) +  
  labs(
    title = "Partidos Ganadores en Zonas Rurales por Año",
    x = "Partido",
    y = "Número de Municipios Rurales Ganados",
    fill = "Partido"
  ) +
  facet_wrap(~ eleccion) +  
  theme_minimal() +  
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +  
  theme(legend.position = "none")

Parte 4

¿Cómo calibrar el error de las encuestas (recordemos que las encuestas son de intención de voto a nivel nacional)?

Podemos ver que los resultados de las encuestas se suelen desviar entre cero con algo y 2 puntos porcentuales

Code
# Preparamos los datos de las encuestas, vemos qué porcentaje de votantes se estiman para cada partido

surveys_general <-
  surveys_tidy |> 
  distinct(date_elec, pollster, field_date_from, field_date_to, size, turnout) |> 
  mutate(personas_turnout = round((size * turnout)/100),0) |> 
  group_by(date_elec, pollster) |> 
  mutate(size = sum(size),
         personas_turnout = sum(personas_turnout, na.rm = TRUE),
         eleccion =  case_when(
            year(date_elec) == 2008 ~ "2008",
            year(date_elec)  == 2011 ~ "2011",
            year(date_elec)  == 2015 ~ "2015",
            year(date_elec)  == 2016 ~ "2016",
            year(date_elec)  == 2019 & month(date_elec)  == "4" ~ 
            "2019 (abril)",
            year(date_elec)  == 2019 &  month(date_elec) == "11" ~ 
              "2019 (noviembre)")) |> 
  distinct(eleccion, pollster, size, personas_turnout)
  
surveys_partido <-
  surveys_tidy |> 
  mutate(votantes = round(((size - turnout)*intencion_voto)/100, 0)) |> 
  group_by(date_elec, pollster, siglas) |> 
  mutate(votantes_estimados = sum(votantes, na.rm = TRUE)) |> 
  distinct(date_elec, pollster, siglas, votantes_estimados) |> 
  left_join(surveys_general, by = c("date_elec" = "date_elec", "pollster" = "pollster")) |> 
  mutate(votos_porc_votantes_cand = round(votantes_estimados / (size - personas_turnout), 2),
         votos_porc_censo = round(votantes_estimados / size, 2),
         eleccion =  case_when(
            year(date_elec) == 2008 ~ "2008",
            year(date_elec)  == 2011 ~ "2011",
            year(date_elec)  == 2015 ~ "2015",
            year(date_elec)  == 2016 ~ "2016",
            year(date_elec)  == 2019 & month(date_elec)  == "4" ~ 
            "2019 (abril)",
            year(date_elec)  == 2019 &  month(date_elec) == "11" ~ 
              "2019 (noviembre)"))  |> 
  group_by(eleccion, siglas) |> 
  mutate(media_porc_encuesta = mean(votos_porc_votantes_cand)) |> 
  ungroup()

# Comparamos los datos reales vs los de las encuestas

comparacion <- 
  left_join(x = surveys_partido, y = datos_partido, by = c("eleccion" = "eleccion", "siglas" = "siglas")) |> 
  select (eleccion, pollster, siglas, votos_porc_votantes_cand.x, votos_porc_votantes_cand.y, votos_porc_censo.x, votos_porc_censo.y) |> 
  mutate(error_relativo_cand = abs(votos_porc_votantes_cand.y - votos_porc_votantes_cand.x) / votos_porc_votantes_cand.y,
         error_relativo_censo = abs(votos_porc_censo.y - votos_porc_censo.x) / votos_porc_censo.y,
         error_real = (votos_porc_votantes_cand.x - votos_porc_votantes_cand.y) / votos_porc_votantes_cand.y ,
         error_positivo_negativo = case_when (error_real >=0 ~ "Positivo", TRUE ~ "Negativo")) |> 
  drop_na(eleccion)
Code
# Propuesta 0 : caja y bigotes

grafico_comparacion_partido <-
  ggplot(comparacion, aes(x = error_relativo_cand, y = siglas, fill = siglas)) +
  geom_boxplot() +
  facet_wrap(~eleccion) +
  scale_fill_manual(values = colores_partidos)  +
    labs(
    x = "Error absoluto relativo",
    y = "Partido",
    fill = "Partido"
  ) +
  guides(fill = "none")
grafico_comparacion_partido

(Para eliminar)

Code
# Propuesta 1 : barras

error_positivo_negativo <-
  comparacion |> 
  group_by(pollster) |> 
  count(error_positivo_negativo) |> 
  mutate(totales = sum(n),
         porc = round(n / totales,1))

orden_pollsters <-
  error_positivo_negativo |> 
  filter(error_positivo_negativo == "Negativo") |> 
  arrange(-porc) |> 
  select(pollster) |> 
  pull()

error_positivo_negativo <-
  error_positivo_negativo |> 
  mutate(pollster = factor(pollster, levels = orden_pollsters, ordered= TRUE))

ggplot(error_positivo_negativo) + 
  geom_col(aes( y = pollster, x = porc, fill = error_positivo_negativo)) +
    theme(axis.text.y = element_text(size = 7))

Para eliminar

Code
# Propuesta 2 : lollipop

# Partido que ganó las elecciones
datos_partido_ganador <- 
  datos_partido |> 
  group_by(eleccion) |> 
  slice_max(votos_partido)

comparacion_filtro <- 
  comparacion |> 
  inner_join(y = datos_partido_ganador, by = c("eleccion" = "eleccion", "siglas" = "siglas")) |> 
  filter(eleccion == "2019 (noviembre)") |> 
  select(eleccion, pollster, error_real)

orden_pollsters2 <-
  comparacion_filtro |> 
  arrange(- error_real) |> 
  select(pollster) |> 
  pull()

comparacion_filtro <-
  comparacion_filtro |> 
  mutate(pollster = factor(pollster, levels = orden_pollsters2, ordered = TRUE))
  
ggplot(comparacion_filtro, aes(x = pollster, y = error_real)) +
  geom_segment( aes(x = pollster, xend = pollster, y=0, yend = error_real), color="grey", size = 1.2) +
  geom_point( color="orange", size = 4) +
  facet_wrap(~ eleccion) +
  theme_light() +
  theme(
    panel.grid.major.x = element_blank(),
    panel.border = element_blank(),
    axis.ticks.x = element_blank(),
    axis.text.x = element_text(angle = 90)
  ) +
  xlab("") +
  ylab("Desviación porc. de los votos reales") +
  coord_flip()
Code
# Propuesta 3: lollipop por años con el promedio

comparacion_filtro3 <- 
  comparacion |> 
  inner_join(y = datos_partido_ganador, by = c("eleccion" = "eleccion", "siglas" = "siglas")) |>
  group_by(eleccion) |> 
  mutate(promedio_error = mean(error_real)) |> 
  distinct(eleccion, promedio_error)


ggplot(comparacion_filtro3, aes(x = eleccion, y = promedio_error)) +
  geom_segment( aes(x = eleccion, xend = eleccion, y=0, yend = promedio_error), color="grey", size = 1.2) +
  geom_point( color="orange", size = 4) +
  theme_light() +
  theme(
    panel.grid.major.x = element_blank(),
    panel.border = element_blank(),
    axis.ticks.x = element_blank(),
    axis.text.x = element_text(angle = 90)
  ) +
  xlab("") +
  ylab("Desviación porc. de los votos reales") +
  coord_flip()

Parece que hay algunas empresas encuestadoras que se desvían más que otras, ver cómo poner este gráfico por años

(Para eliminar)

Code
# Propuesta 4: cajas y bigotes por encuestadora
grafico_comparacion_pollster <-
  comparacion |> 
  filter(eleccion == "2015") |> 
  ggplot( aes(x = error_relativo_cand, y = pollster, fill = pollster)) +
  geom_boxplot() +
  labs(
    x = "Error absoluto relativo",
    y = "Encuestadora",
    fill = "Encuestadora"
  ) +
  guides(fill = "none") +
  facet_wrap(~eleccion) 
grafico_comparacion_pollster

Parte 4

¿La intención de voto reportada en las encuestas muestra tendencias consistentes con las tasas de participación reales en todas las elecciones?

Code
participacion_actual <- tabla_maestra |> 
  group_by(anno, mes) |> 
  summarise(
    censo_total = sum(censo, na.rm = TRUE),
    votos_candidaturas_total = sum(votos_candidaturas, na.rm = TRUE),
    .groups = "keep"
  ) |>
  mutate(participacion_rate_actual = votos_candidaturas_total / censo_total)


participacion_actual <- participacion_actual |> 
  mutate(
    year_month = as.Date(paste(anno, mes, "1", sep = "-"), format = "%Y-%m-%d")
  )


ggplot(participacion_actual, aes(x = year_month, y = participacion_rate_actual)) +
  geom_line(color = "blue", size = 1) +
  geom_point(color = "red", size = 2) +
  labs(
    title = "Porcentaje de participación real por año y mes",
    x = "Año-Mes",
    y = "Porcentaje de participación (Actual)"
  ) +
  scale_x_date(
    date_labels = "%Y-%m",
    breaks = participacion_actual$year_month  
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1), 
    legend.position = "none"
  )
Code
survey_participacion_month <- surveys_tidy |> 
  mutate(
    anno = year(as.Date(date_elec)),  
    mes = month(as.Date(date_elec))  
  ) |> 
  group_by(anno, mes) |> 
  summarise(
    turnout_mean = mean(turnout, na.rm = TRUE), 
    .groups = "drop"
  ) |> 
  mutate(year_month = as.Date(paste(anno, mes, "1", sep = "-"), format = "%Y-%m-%d"))

ggplot(survey_participacion_month, aes(x = year_month, y = turnout_mean)) +
  geom_line(color = "blue", size = 1) +
  geom_point(color = "red", size = 2) +
  labs(
    title = "Participación electoral promedio por año y mes",
    x = "Año-Mes",
    y = "Participación media (%)"
  ) +
  scale_x_date(
    date_labels = "%Y-%m",
    breaks = survey_participacion_month$year_month) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1) 
  )
Code
participacion_diff <- left_join(
  participacion_actual, survey_participacion_month, by = "year_month"
) |> 
  mutate(
    participacion_diff = participacion_rate_actual - (turnout_mean / 100)
  )

ggplot(participacion_diff, aes(x = year_month, y = participacion_diff)) +
  geom_line(color = "blue", size = 1) +
  geom_point(color = "red", size = 2) +
  scale_x_date(
    date_labels = "%Y-%m",
    breaks = participacion_diff$year_month) +
  labs(
    title = "Diferencia entre las tasas de participación reales y previstas",
    x = "Año-Mes",
    y = "Diferencia en el porcentaje de participación (real - prevista)"
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1) 
  )

Parte 5

¿Cómo se distribuyeron los escaños en cada elección?

Code
# Preparación para gráfico escaños

datos_elecciones_provincia <- 
  tabla_maestra |>
  group_by(anno, mes, codigo_provincia) |> 
  distinct(anno, mes, codigo_provincia, votos_blancos, votos_candidaturas) |> 
  mutate(votos_blancos = sum(votos_blancos),
         votos_candidaturas = sum(votos_candidaturas),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup() |> 
  distinct(eleccion, codigo_provincia, votos_blancos, votos_candidaturas) 

datos_partido_provincia <-
  tabla_maestra |> 
  group_by(anno, mes, codigo_provincia,  partido) |> 
  mutate(votos_partido = sum(votos),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup() |> 
  distinct(anno, eleccion, codigo_provincia, partido, votos_partido) 
  #left_join(datos_elecciones_provincia, by = c("eleccion" = "eleccion", "codigo_provincia" = "codigo_provincia")) |> 
  #mutate(porc_votos_validos = round(votos_partido / (votos_candidaturas + votos_blancos), 2)) # % votos de la provincia
  #filter(porc_votos_validos >= 0.03)   # Para participar en D'Hondt 


# datos_partido_provincia |> 
#   group_by(eleccion, partido) |> 
#   summarise(suma = sum(votos_partido)) |> 
#   ungroup() |> 
#   write.csv(file="votos_partidos.csv")


# Importamos el número de escaños por provincia y año

escannos_provincia_anno <- read_csv("data/escannos_provincia_anno.csv")

escannos_provincia_anno <-
  escannos_provincia_anno |> 
  mutate(codigo_provincia = as.character(case_when(
          Provincia == "Madrid" ~ "28",
          Provincia == "Barcelona" ~ "08",
          Provincia == "Valencia" ~ "46",
          Provincia == "Sevilla" ~ "41",
          Provincia == "Alicante" ~ "03",
          Provincia == "Málaga" ~ "29",
          Provincia == "Murcia" ~ "30",
          Provincia == "Cádiz" ~ "11",
          Provincia == "Baleares" ~ "07",
          Provincia == "La Coruña" ~ "15",
          Provincia == "Las Palmas" ~ "35",
          Provincia == "Asturias" ~ "33",
          Provincia == "Granada" ~ "18",
          Provincia == "Pontevedra" ~ "36",
          Provincia == "Santa Cruz de Tenerife" ~ "38",
          Provincia == "Zaragoza" ~ "50",              
          Provincia == "Almería" ~ "04",
          Provincia == "Córdoba" ~ "14",
          Provincia == "Gerona" ~ "17",
          Provincia == "Guipúzcoa" ~ "20",
          Provincia == "Tarragona" ~ "43",
          Provincia == "Toledo" ~ "45",
          Provincia == "Badajoz" ~ "06",
          Provincia == "Cantabria" ~ "39",
          Provincia == "Castellón" ~ "12",
          Provincia == "Ciudad Real" ~ "13",
          Provincia == "Huelva" ~ "21",
          Provincia == "Jaén" ~ "23",
          Provincia == "Navarra" ~ "31",
          Provincia == "Valladolid"  ~ "47",
          Provincia == "Álava" ~ "01",
          Provincia == "Albacete" ~ "02",
          Provincia == "Burgos" ~ "09",
          Provincia == "Cáceres" ~ "10",
          Provincia == "León" ~ "24",
          Provincia == "Lérida"  ~ "25",
          Provincia == "Lugo" ~ "27",
          Provincia == "Orense" ~ "32",
          Provincia == "La Rioja" ~ "26",
          Provincia == "Salamanca"  ~ "37",
          Provincia == "Ávila" ~ "05",
          Provincia == "Cuenca" ~ "16",
          Provincia == "Guadalajara" ~ "19",
          Provincia == "Huesca"  ~ "22",
          Provincia == "Palencia"  ~ "34",
          Provincia == "Segovia" ~ "40",
          Provincia == "Teruel" ~ "44",
          Provincia == "Vizcaya" ~ "48",
          Provincia == "Zamora" ~ "49",
          Provincia == "Soria" ~ "42",
          Provincia == "Ceuta" ~ "51",
          Provincia == "Melilla" ~ "52"))) |> 
  distinct() 


datos_provincia_escannos <-
  datos_partido_provincia |> 
  left_join(escannos_provincia_anno, by = c("anno" = "Año", "codigo_provincia" = "codigo_provincia")) |> 
  select(eleccion, codigo_provincia, partido, votos_partido, "Número de escaños")

## Función D'Hondt
dHondt <- function(votos, partidos, escaños) {
  
  # Formato tibble
  tabla <- tibble(partido = partidos, votos = votos)
  
  # Divisores
  divisores <- rep(1, length(votos))
  escaños_asignados <- integer(length(votos))
  
  # Tenemos que repetir el proceso por escaños
  for (i in 1:escaños) {
    # Máximo cociente
    cocientes <- votos / divisores
    max_index <- which.max(cocientes)
    escaños_asignados[max_index] <- escaños_asignados[max_index] + 1
    divisores[max_index] <- divisores[max_index] + 1
  }
  
  # Resultado final
  resultado <- tibble(
    partido = partidos,
    escaños = escaños_asignados
  )
  
  return(resultado)
}


## Función DHondt por provincias

dHondt_provincias <- function(tibble) {
  
  # Inicializamos los resultados
  resultados_dhondt <- tibble()
  
  # Por cada elección de las que tenemos
  for (elec in unique(tibble$eleccion)) {
    # Filtrar por elección actual
    tibble_funcion <- 
      tibble |> 
      filter(eleccion == elec)
    
    # Por cada provincia, ya que cada una tiene unos escaños
    for (provin in unique(tibble_funcion$codigo_provincia)) {
      # Filtrar por provincia actual
      tibble_funcion2 <- 
        tibble_funcion |> 
        filter(codigo_provincia == provin)
      
      # Aplicamos la función de antes
      resultados <- 
        dHondt(
        votos = tibble_funcion2$votos_partido, 
        partidos = tibble_funcion2$partido, 
        escaños = unique(tibble_funcion2$`Número de escaños`)
      )
      
      # Añadimos qué elección es y provincia
      resultados <- 
        resultados |> 
        mutate(eleccion = elec, 
               codigo_provincia = provin)
      
      # Añadimos a la inicialización
      resultados_dhondt <- bind_rows(resultados_dhondt, resultados)
    }
  }
  
  return(resultados_dhondt)
}

resultado_dhondt <-
  dHondt_provincias(datos_provincia_escannos) 
# |> 
#   group_by(eleccion, partido) |> 
#   summarise(sum(escaños)) |> 
#   write.csv(file = "escaños_partidos.csv")


congreso <- 
  resultado_dhondt |> 
  rowwise() |> 
  mutate(partido = cambia_nombres(partido, nombres = nombres_partidos)) |>
  ungroup() |> 
  mutate(siglas = case_when(
            partido == "PARTIDO SOCIALISTA OBRERO ESPAÑOL" ~ "PSOE",
            partido == "PARTIDO POPULAR" ~ "PP",
            partido == "CIUDADANOS" ~ "C's",
            partido == "BLOQUE NACIONALISTA GALLEGO" ~ "BNG",
            partido == "ESQUERRA REPUBLICANA DE CATALUNYA" ~ "ERC",
            partido == "UNIDAS PODEMOS - IU" ~ "PODEMOS-IU",
            partido == "EH - BILDU" ~ "EH-BILDU",
            partido == "PARTIDO NACIONALISTA VASCO" ~ "PNV",
            partido == "VOX" ~ "VOX",
            TRUE ~ "OTRO" )) |> 
   group_by(siglas, eleccion) |> 
   summarise(escannos = sum(escaños)) |> 
     ungroup() #|> 
  #arrange(eleccion, escannos)

congreso <- 
  congreso |> 
  mutate(siglas = factor(siglas, 
                         levels = unique(congreso$siglas), 
                         labels = c("BNG", "C's", "EH-BILDU", "ERC", "OTRO", "PNV", "PODEMOS-IU", "PP", "PSOE", "VOX"), 
                         ordered = TRUE)) 
Code
## Gráfico de congreso

# Tenemos que filtar por años, porque la geometria geom_parliament() da problemas
# con las leyends de colores/relleno con los facet wrap si los niveles de las 
# leyendas no son exactamente los mismos siempre.

# 2008 #

congreso_2008 <-
congreso |> 
           filter(eleccion == "2008")

# congreso_2008 |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2008 <- c(
  "8" = "#17589d", # PP
  "9" = "#c20e1a", # SOE
  "6" = "#308444", # PNV 
  "5" = "#808080", # OTRO 
  "7" = "#308444", # PNV
  "10" = "#308444", # PNV
  "4" = "#FFD700", #ERC
  "3" = "#76b3dd",
  "1" = "#76b3dd"
  )

congreso_2008_g <- 
  ggplot(congreso_2008)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2008) +
  scale_color_manual(values = colores_2008) +
  guides(color = "none", fill = "none") +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA)) +
  coord_fixed()
  

congreso_2008_t <-
  congreso_2008 |> 
  filter(eleccion == "2008" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos) |> 
  filter(escannos > 0)

congreso_2008_tg <- 
  ggplot(congreso_2008_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3.5) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso1 <- grid.arrange(congreso_2008_g, congreso_2008_tg, ncol = 2,
             top = textGrob("2008", gp = gpar(fontsize = 12, fontface = "bold") 
  ))
Code
# 2011 #

congreso_2011 <-
congreso |> 
           filter(eleccion == "2011")

# congreso_2011 |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2011 <- c(
  "6" = "#17589d", # PP
  "7" = "#c20e1a", # SOE
  "5" = "#308444", # PNV
  "4" = "#308444", # PNV 
  "3" = "#808080", # OTRO 
  "2" = "#fcc34e", # ERC
  "1" = "#76b3dd" #BNG
)

congreso_2011_g <- 
  ggplot(congreso_2011)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2011) +
  scale_color_manual(values = colores_2011) +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA)) +
  guides(color = "none", fill = "none") +
  coord_fixed()
  

congreso_2011_t <-
  congreso_2011 |> 
  filter(eleccion == "2011" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos) |> 
  filter(escannos > 0)

congreso_2011_tg <- 
  ggplot(congreso_2011_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3.5) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso2 <- grid.arrange(congreso_2011_g, congreso_2011_tg, ncol = 2,
             top = textGrob("2011", gp = gpar(fontsize = 12, fontface = "bold") ))
Code
# 2015 #

congreso_2015 <-
congreso |> 
           filter(eleccion == "2015")
# 
# congreso_2015 |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2015 <- c(
  "7" = "#17589d", # PP
  "8" = "#c20e1a", # SOE
  "9" = "#c20e1a", # SOE
  "6" = "#6b1f5f", # Podemos
  "1" = "#fb5000", # Cs
  "4" = "#808080", # OTRO 
  "3" = "#fcc34e", # ERC
  "2" = "#1af7db", # PNV 
  "5" = "#006400" #BILDU
)

congreso_2015_g <- 
  ggplot(congreso_2015)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2015) +
  scale_color_manual(values = colores_2015) +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA)) +
  guides(color = "none", fill = "none") +
  coord_fixed()
  


congreso_2015_t <-
  congreso_2015 |> 
  filter(eleccion == "2015" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos) |> 
  filter(escannos > 0)

congreso_2015_tg <- 
  ggplot(congreso_2015_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3.5) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso3 <- grid.arrange(congreso_2015_g, congreso_2015_tg, ncol = 2,
             top = textGrob("2015", gp = gpar(fontsize = 12, fontface = "bold") 
  ))
Code
# 2016 #

congreso_2016 <-
congreso |> 
           filter(eleccion == "2016")

# congreso_2016 |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2016 <- c(
  "6" = "#17589d", # PP
  "7" = "#c20e1a", # SOE
  "8" = "#c20e1a", # SOE, lo repito porque se quedaba un punto gris
  "5" = "#6b1f5f", # Podemos
  "3" = "#fb5000", # Cs
  "1" = "#808080", # OTRO 
  "4" = "#308444", # PNV 
  "2" = "#1af7db" #BILDU
)

congreso_2016_g <- 
  ggplot(congreso_2016)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2016) +
  scale_color_manual(values = colores_2016) +
  guides(color = "none", fill = "none") +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA)) +
  coord_fixed()
  


congreso_2016_t <-
  congreso_2016 |> 
  filter(eleccion == "2016" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos) |> 
  filter(escannos > 0)

congreso_2016_tg <- 
  ggplot(congreso_2016_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3.5) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso4 <- grid.arrange(congreso_2016_g, congreso_2016_tg, ncol = 2,
             top = textGrob("2016", gp = gpar(fontsize = 12, fontface = "bold") ))
Code
# "2019 (abril)"  #

congreso_2019a <-
congreso |> 
           filter(eleccion == "2019 (abril)" )

# congreso_2019a |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2019a <- c(
  "8" = "#17589d", # PP
  "9" = "#c20e1a", # SOE
  "7" = "#6b1f5f", # Podemos
  "2" = "#fb5000", # Cs
  "5" = "#808080", # OTRO 
  "6" = "#308444", # PNV 
  "3" = "#1af7db", #BILDU
  "10" = "#5ac035", #VOX
  "4" = "#fcc34e" # ERC
)

congreso_2019a_g <- 
  ggplot(congreso_2019a)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2019a) +
  scale_color_manual(values = colores_2019a) +
  guides(color = "none", fill = "none") +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA))+
  coord_fixed()
  

congreso_2019a_t <-
  congreso_2019a |> 
  filter(eleccion == "2019 (abril)" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos) |> 
  filter(escannos > 0)

congreso_2019a_tg <- 
  ggplot(congreso_2019a_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso5 <- grid.arrange(congreso_2019a_g, congreso_2019a_tg, ncol = 2,
             top = textGrob("2019 abril", gp = gpar(fontsize = 12, fontface = "bold")  ))
Code
# "2019 (noviembre)"  #

congreso_2019n <-
congreso |> 
           filter(eleccion == "2019 (noviembre)" )

# congreso_2019n |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2019n <- c(
  "8" = "#17589d", # PP
  "9" = "#c20e1a", # SOE
  "7" = "#6b1f5f", # Podemos
  "2" = "#fb5000", # Cs
  "5" = "#808080", # OTRO 
  "6" = "#308444", # PNV 
  "3" = "#1af7db", #BILDU
  "10" = "#5ac035", #VOX
  "4" = "#fcc34e", # ERC
  "1" = "#76b3dd" #BNG
)

congreso_2019n_g <- 
  ggplot(congreso_2019n)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2019n) +
  scale_color_manual(values = colores_2019n) +
  guides(color = "none", fill = "none") +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA)) +
  coord_fixed()
  
congreso_2019n_t <-
  congreso_2019n |> 
  filter(eleccion == "2019 (noviembre)" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos)

congreso_2019n_tg <- 
  ggplot(congreso_2019n_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso6 <- grid.arrange(congreso_2019n_g, congreso_2019n_tg, ncol = 2,
             top = textGrob("2019 noviembre", gp = gpar(fontsize = 12, fontface = "bold") ))
Code
grid.arrange(grafico_congreso1, grafico_congreso2, grafico_congreso3, grafico_congreso4, grafico_congreso5, grafico_congreso6, ncol = 2, nrow = 3)

Parte 6